home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / crsbas.zip / CROSSBAS.INC < prev    next >
Text File  |  1990-12-01  |  14KB  |  423 lines
  1. '┌─────────────────────────────────────────────────────────────────────┐
  2. '└── beginning of crossbas.inc ────────────────────────────────────────┘
  3.  
  4. '    Include file for CrossBas.bas
  5. '    Lester L. Noll
  6. '    CompuServe Id:  72250,2551
  7. '    copyright (c)  November 13, 1989, 1990
  8.  
  9. '─── flush keyboard buffer ─────────────────────────────────────────────
  10. SUB FlushKeyBuf              'Flush any waiting keystrokes.
  11.  
  12.     WHILE INSTAT
  13.       InK$ =INKEY$
  14.       WEND
  15.     END SUB
  16.  
  17. '─── dimension cmd line array ──────────────────────────────────────────
  18. SUB DimCmdLine(DimCmd%)    'Find number of elements in command line to dimension
  19.             ' the parameter$ array of ReadCmdLine() procedure.
  20.  
  21.     LOCAL I%, Char$, CmdLine$, DelimitFlag%
  22.     DimCmd% =0
  23.     DelimitFlag% =-1
  24.     CmdLine$=COMMAND$
  25.     FOR I% =1 TO LEN(CmdLine$)    'Increment through the cmd line 1 char at a time.
  26.       Char$=MID$(CmdLine$,I%,1)
  27.       SELECT CASE Char$
  28.         CASE " "        :  GOTO DimCmdLine.1        'Space char.
  29.         CASE ","    :  GOTO DimCmdLine.1        'Comma char.
  30.         CASE "/"        :  GOTO DimCmdLine.1        'Switch char.
  31.         CASE ""        :  GOTO DimCmdLine.1        'No more chars.
  32.         CASE CHR$(0) TO CHR$(31)  :  GOTO DimCmdLine.2    'Non-anphanumeric
  33.         CASE >CHR$(125)    :  GOTO DimCmdLine.2        'Non-alphanumeric
  34.         END SELECT
  35.       DelimitFlag% =0
  36.       GOTO DimCmdLine.2
  37.  
  38. DimCmdLine.1:
  39.       IF DelimitFlag% THEN DimCmdLine.2
  40.       DelimitFlag% =-1
  41.       INCR DimCmd%
  42.  
  43. DimCmdLine.2:
  44.       NEXT I%
  45.     INCR DimCmd%
  46.   END SUB
  47.  
  48.  
  49. '─── read DOS command line ─────────────────────────────────────────────
  50. SUB ParseCmdLine(Cmd$(1))    'This subprogram will parse the DOS command line
  51.                              ' and return the non-blank characters as members
  52.                              ' of the array Cmd$().  The maximum number of
  53.                              ' command line characters is 127.
  54.                              'If you expect to see more than 10 command line
  55.                              ' parameters, you must include a DIM Cmd$()
  56.                              ' statement prior to calling this subprogram.
  57.                              'You should include a $DYNAMIC statement at the
  58.                              ' top of the calling program so that after you are
  59.                              ' finished with the Cmd$() array you can ERASE it.
  60.  
  61.   LOCAL I%, J%, Char$, Temp$, CmdLine$, DelimitFlag%
  62.   DelimitFlag% =-1
  63.   CmdLine$=COMMAND$
  64.   FOR I% =1 TO LEN(CmdLine$)+1    'Increment through the cmd line 1 char at a time.
  65.     Char$=MID$(CmdLine$,I%,1)
  66.     SELECT CASE Char$
  67.       CASE " "                     :  GOTO ParseCmdLine.6    'Space char.
  68.       CASE ","                     :  GOTO ParseCmdLine.6    'Comma char.
  69.       CASE ""            :  GOTO ParseCmdLine.4    'No more chars.
  70.       CASE CHR$(0) TO CHR$(31)     :  GOTO ParseCmdLine.9    'Ignore non alpha-num.
  71.       CASE "/"                     :  GOTO ParseCmdLine.5    'Switch delimiter.
  72.       CASE ELSE                    :  GOTO ParseCmdLine.7
  73.       END SELECT
  74.  
  75. ParseCmdLine.4:                        'No more chars on cmd line.
  76.     I% =128
  77.     GOTO ParseCmdLine.8
  78.  
  79. ParseCmdLine.5:                    'Switch delimiter.
  80.     IF Temp$ ="/" GOTO ParseCmdLine.9
  81.     IF NOT (Temp$ ="") THEN ParseCmdLine.8
  82.     GOTO ParseCmdLine.7
  83.  
  84. ParseCmdLine.6:                    'Space delimiter.
  85.     IF DelimitFlag% THEN ParseCmdLine.9
  86.     DelimitFlag% =-1
  87.     GOTO ParseCmdLine.8
  88.  
  89. ParseCmdLine.7:                    'Normal text.
  90.     DelimitFlag% =0
  91.     Temp$ =Temp$ +Char$
  92.     GOTO ParseCmdLine.9
  93.  
  94. ParseCmdLine.8:                    'Save word and start next.
  95.     INCR J%
  96.     Cmd$(J%) =Temp$
  97.     IF Char$ ="/" THEN Temp$ =Char$ ELSE Temp$ =""
  98.  
  99. ParseCmdLine.9:                    'Get next character.
  100.     NEXT I%
  101.  
  102.   END SUB
  103.  
  104.  
  105. '─── calculate the drive portion of a file path ────────────────────────
  106. SUB CalcDr(FilePath$,Dr$)
  107.  
  108.     LOCAL C%
  109.     Dr$ =""
  110.     IF NOT (FilePath$ ="") THEN
  111.       C% =INSTR(FilePath$,":")
  112.       IF C% =2 THEN
  113.           SELECT CASE UCASE$(LEFT$(FilePath$,1))
  114.             CASE "A" TO "J"    :    Dr$ =LEFT$(FilePath$,2)
  115.             END SELECT
  116.         END IF
  117.      END IF
  118.   END SUB
  119.  
  120.  
  121. '─── calculate the directory portion of a file path ────────────────────
  122. SUB CalcDir(FilePath$,Dir$)
  123.  
  124.     LOCAL I%, I1%, I2%
  125.     Dir$ =""
  126.     IF NOT FilePath$ ="" THEN
  127.       I% =INSTR(FilePath$,"\")
  128.       IF I% >0 THEN
  129.           I1% =I%
  130.           WHILE I% >0
  131.             I2% =I%
  132.             I% =INSTR(I2%+1,FilePath$,"\")
  133.             WEND
  134.             Dir$ =MID$(FilePath$,I1%,I2%-I1%+1)
  135.         END IF
  136.       IF NOT Dir$ ="" THEN
  137.           IF NOT LEFT$(Dir$,1) ="\" THEN Dir$ ="\" +Dir$
  138.           IF NOT RIGHT$(Dir$,1) ="\" THEN Dir$ =Dir$ +"\"
  139.         END IF
  140.       END IF
  141.   END SUB
  142.  
  143.  
  144. '─── calculate the filename portion of a file path ─────────────────────
  145. SUB CalcName(FilePath$,FileName$)
  146.  
  147.     LOCAL C%, I%, I1%
  148.     FileName$ =""
  149.     IF NOT (FilePath$ ="") THEN
  150.         C% =INSTR(FilePath$,":")
  151.         IF NOT (C% =2) THEN C% =0
  152.         I% =INSTR(FilePath$,"\")
  153.         WHILE I% >0
  154.           I1% =I%
  155.           I% =INSTR(I%+1,FilePath$,"\")
  156.           WEND
  157.         IF I1% >0 THEN
  158.             FileName$ =MID$(FilePath$,I1%+1)
  159.           ELSEIF C% =2 THEN
  160.             FileName$ =MID$(FilePath$,3)
  161.           ELSE
  162.             FileName$ =FilePath$
  163.           END IF
  164.       END IF
  165.   END SUB
  166.  
  167. '─── catch runtime error ────────────────────────────────────────────────
  168. SUB CatchRuntime
  169.  
  170.     BEEP: DELAY 1: BEEP: DELAY 1: BEEP
  171.     PRINT
  172.     PRINT "Fatal Error Encountered!!"
  173.     PRINT
  174.     PRINT "Error #";STR$(ERR);" at PC counter ";
  175.       PRINT ERADR
  176.     PRINT fnErrorMsg$
  177.     IF ERDEV >0 THEN
  178.         PRINT "Device #";ERDEV$; ", "; STR$(ERDEV)
  179.       END IF
  180.     PRINT "End Memory    =";
  181.       PRINT ENDMEM
  182.     PRINT "String Segment=";
  183.       Temp& =(VARSEG(S$))
  184.       Temp& =Temp&*16
  185.       PRINT Temp&,
  186.       PRINT "Hex: "; HEX$(VARSEG(S$));":";HEX$(VARPTR(S$))
  187.     PRINT "String Space  =";
  188.       PRINT FRE(S$)
  189.     PRINT "Array Space   =";
  190.       PRINT FRE(-1)
  191.     PRINT "Stack Space   =";
  192.       PRINT FRE(-2)
  193.   END SUB
  194.  
  195.  
  196. '─── get error description ─────────────────────────────────────────────
  197. DEF fnErrorMsg$
  198.  
  199.     LOCAL ErrNum%, Temp$
  200.     ErrNum% =ERR
  201.     SELECT CASE ErrNum%    
  202.       CASE  0   :          Temp$ =""
  203.       CASE  2   :          Temp$ ="Syntax error"
  204.       CASE  3   :          Temp$ ="RETURN without GOSUB"
  205.       CASE  4   :          Temp$ ="Out of data"
  206.       CASE  5   :          Temp$ ="Illegal functin call"
  207.       CASE  6   :          Temp$ ="Overflow"
  208.       CASE  7   :          Temp$ ="Out of memory"
  209.       CASE  9   :          Temp$ ="Subscript out of range"
  210.       CASE 10   :          Temp$ ="Duplicate definition"
  211.       CASE 11   :          Temp$ ="Division by zero"
  212.       CASE 13   :          Temp$ ="Type mismatch"
  213.       CASE 14   :          Temp$ ="Out of string space"
  214.       CASE 15   :          Temp$ ="String too long"
  215.       CASE 19   :          Temp$ ="No RESUME"
  216.       CASE 20   :          Temp$ ="RESUME without error"
  217.       CASE 24   :          Temp$ ="Device Timeout"
  218.       CASE 25   :          Temp$ ="Device hardware error"
  219.       CASE 27   :          Temp$ ="Printer out of paper"
  220.       CASE 50   :          Temp$ ="Field overflow"
  221.       CASE 51   :          Temp$ ="Internal error"
  222.       CASE 52   :          Temp$ ="Bad file number"
  223.       CASE 53   :          Temp$ ="File not found"
  224.       CASE 54   :          Temp$ ="Bad file mode"
  225.       CASE 55   :          Temp$ ="File already open"
  226.       CASE 57   :          Temp$ ="Device I/O error"
  227.       CASE 58   :          Temp$ ="File already exists"
  228.       CASE 61   :          Temp$ ="Disk is full"
  229.       CASE 62   :          Temp$ ="Input past end"
  230.       CASE 63   :          Temp$ ="Bad record number"
  231.       CASE 64   :          Temp$ ="Bad file name"
  232.       CASE 67   :          Temp$ ="Too many files in directory or bad file spec"
  233.       CASE 68   :          Temp$ ="Device not available"
  234.       CASE 69   :          Temp$ ="Communications buffer overflow"
  235.       CASE 70   :          Temp$ ="Disk is write protected"
  236.       CASE 71   :          Temp$ ="Disk not ready"
  237.       CASE 72   :          Temp$ ="Disk media error"
  238.       CASE 74   :          Temp$ ="Rename across disks"
  239.       CASE 75   :